home *** CD-ROM | disk | FTP | other *** search
/ Complete Internet Archive / Complete Internet Archive.iso / VRML / cp2b2x.exe / DATA.Z / text.tcl < prev    next >
Text File  |  1996-04-23  |  21KB  |  792 lines
  1. # text.tcl --
  2. #
  3. # This file defines the default bindings for Tk text widgets and provides
  4. # procedures that help in implementing the bindings.
  5. #
  6. # @(#) text.tcl 1.36 95/06/28 10:24:23
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #-------------------------------------------------------------------------
  16. # Elements of tkPriv that are used in this file:
  17. #
  18. # afterId -        If non-null, it means that auto-scanning is underway
  19. #            and it gives the "after" id for the next auto-scan
  20. #            command to be executed.
  21. # char -        Character position on the line;  kept in order
  22. #            to allow moving up or down past short lines while
  23. #            still remembering the desired position.
  24. # mouseMoved -        Non-zero means the mouse has moved a significant
  25. #            amount since the button went down (so, for example,
  26. #            start dragging out a selection).
  27. # prevPos -        Used when moving up or down lines via the keyboard.
  28. #            Keeps track of the previous insert position, so
  29. #            we can distinguish a series of ups and downs, all
  30. #            in a row, from a new up or down.
  31. # selectMode -        The style of selection currently underway:
  32. #            char, word, or line.
  33. # x, y -        Last known mouse coordinates for scanning
  34. #            and auto-scanning.
  35. #-------------------------------------------------------------------------
  36.  
  37. # tkTextClipboardKeysyms --
  38. # This procedure is invoked to identify the keys that correspond to
  39. # the "copy", "cut", and "paste" functions for the clipboard.
  40. #
  41. # Arguments:
  42. # copy -    Name of the key (keysym name plus modifiers, if any,
  43. #        such as "Meta-y") used for the copy operation.
  44. # cut -        Name of the key used for the cut operation.
  45. # paste -    Name of the key used for the paste operation.
  46.  
  47. proc tkTextClipboardKeysyms {copy cut paste} {
  48.     bind Text <$copy> {
  49.     if {[selection own -displayof %W] == "%W"} {
  50.         clipboard clear -displayof %W
  51.         catch {
  52.         clipboard append -displayof %W [selection get -displayof %W]
  53.         }
  54.     }
  55.     }
  56.     bind Text <$cut> {
  57.     if {[selection own -displayof %W] == "%W"} {
  58.         clipboard clear -displayof %W
  59.         catch {
  60.         clipboard append -displayof %W [selection get -displayof %W]
  61.         %W delete sel.first sel.last
  62.         }
  63.     }
  64.     }
  65.     bind Text <$paste> {
  66.     catch {
  67.         %W insert insert [selection get -displayof %W \
  68.             -selection CLIPBOARD]
  69.     }
  70.     }
  71. }
  72.  
  73. #-------------------------------------------------------------------------
  74. # The code below creates the default class bindings for entries.
  75. #-------------------------------------------------------------------------
  76.  
  77.     # Standard Motif bindings:
  78.  
  79. bind Text <1> {
  80.     tkTextButton1 %W %x %y
  81.     %W tag remove sel 0.0 end
  82. }
  83. bind Text <B1-Motion> {
  84.     set tkPriv(x) %x
  85.     set tkPriv(y) %y
  86.     tkTextSelectTo %W %x %y
  87. }
  88. bind Text <Double-1> {
  89.     set tkPriv(selectMode) word
  90.     tkTextSelectTo %W %x %y
  91.     catch {%W mark set insert sel.first}
  92. }
  93. bind Text <Triple-1> {
  94.     set tkPriv(selectMode) line
  95.     tkTextSelectTo %W %x %y
  96.     catch {%W mark set insert sel.first}
  97. }
  98. bind Text <Shift-1> {
  99.     tkTextResetAnchor %W @%x,%y
  100.     set tkPriv(selectMode) char
  101.     tkTextSelectTo %W %x %y
  102. }
  103. bind Text <Double-Shift-1>    {
  104.     set tkPriv(selectMode) word
  105.     tkTextSelectTo %W %x %y
  106. }
  107. bind Text <Triple-Shift-1>    {
  108.     set tkPriv(selectMode) line
  109.     tkTextSelectTo %W %x %y
  110. }
  111. bind Text <B1-Leave> {
  112.     set tkPriv(x) %x
  113.     set tkPriv(y) %y
  114.     tkTextAutoScan %W
  115. }
  116. bind Text <B1-Enter> {
  117.     tkCancelRepeat
  118. }
  119. bind Text <ButtonRelease-1> {
  120.     tkCancelRepeat
  121. }
  122. bind Text <Control-1> {
  123.     %W mark set insert @%x,%y
  124. }
  125. bind Text <Left> {
  126.     tkTextSetCursor %W [%W index {insert - 1c}]
  127. }
  128. bind Text <Right> {
  129.     tkTextSetCursor %W [%W index {insert + 1c}]
  130. }
  131. bind Text <Up> {
  132.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  133. }
  134. bind Text <Down> {
  135.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  136. }
  137. bind Text <Shift-Left> {
  138.     tkTextKeySelect %W [%W index {insert - 1c}]
  139. }
  140. bind Text <Shift-Right> {
  141.     tkTextKeySelect %W [%W index {insert + 1c}]
  142. }
  143. bind Text <Shift-Up> {
  144.     tkTextKeySelect %W [tkTextUpDownLine %W -1]
  145. }
  146. bind Text <Shift-Down> {
  147.     tkTextKeySelect %W [tkTextUpDownLine %W 1]
  148. }
  149. bind Text <Control-Left> {
  150.     tkTextSetCursor %W [%W index {insert - 1c wordstart}]
  151. }
  152. bind Text <Control-Right> {
  153.     tkTextSetCursor %W [%W index {insert wordend}]
  154. }
  155. bind Text <Control-Up> {
  156.     tkTextSetCursor %W [tkTextPrevPara %W insert]
  157. }
  158. bind Text <Control-Down> {
  159.     tkTextSetCursor %W [tkTextNextPara %W insert]
  160. }
  161. bind Text <Shift-Control-Left> {
  162.     tkTextKeySelect %W [%W index {insert - 1c wordstart}]
  163. }
  164. bind Text <Shift-Control-Right> {
  165.     tkTextKeySelect %W [%W index {insert wordend}]
  166. }
  167. bind Text <Shift-Control-Up> {
  168.     tkTextKeySelect %W [tkTextPrevPara %W insert]
  169. }
  170. bind Text <Shift-Control-Down> {
  171.     tkTextKeySelect %W [tkTextNextPara %W insert]
  172. }
  173. bind Text <Prior> {
  174.     tkTextSetCursor %W [tkTextScrollPages %W -1]
  175. }
  176. bind Text <Shift-Prior> {
  177.     tkTextKeySelect %W [tkTextScrollPages %W -1]
  178. }
  179. bind Text <Next> {
  180.     tkTextSetCursor %W [tkTextScrollPages %W 1]
  181. }
  182. bind Text <Shift-Next> {
  183.     tkTextKeySelect %W [tkTextScrollPages %W 1]
  184. }
  185. bind Text <Control-Prior> {
  186.     %W xview scroll -1 page
  187. }
  188. bind Text <Control-Next> {
  189.     %W xview scroll 1 page
  190. }
  191.  
  192. bind Text <Home> {
  193.     tkTextSetCursor %W {insert linestart}
  194. }
  195. bind Text <Shift-Home> {
  196.     tkTextKeySelect %W {insert linestart}
  197. }
  198. bind Text <End> {
  199.     tkTextSetCursor %W {insert lineend}
  200. }
  201. bind Text <Shift-End> {
  202.     tkTextKeySelect %W {insert lineend}
  203. }
  204. bind Text <Control-Home> {
  205.     tkTextSetCursor %W 1.0
  206. }
  207. bind Text <Control-Shift-Home> {
  208.     tkTextKeySelect %W 1.0
  209. }
  210. bind Text <Control-End> {
  211.     tkTextSetCursor %W {end - 1 char}
  212. }
  213. bind Text <Control-Shift-End> {
  214.     tkTextKeySelect %W {end - 1 char}
  215. }
  216.  
  217. bind Text <Tab> {
  218.     tkTextInsert %W \t
  219.     focus %W
  220.     break
  221. }
  222. bind Text <Shift-Tab> {
  223.     # Needed only to keep <Tab> binding from triggering;  doesn't
  224.     # have to actually do anything.
  225. }
  226. bind Text <Control-Tab> {
  227.     focus [tk_focusNext %W]
  228. }
  229. bind Text <Control-Shift-Tab> {
  230.     focus [tk_focusPrev %W]
  231. }
  232. bind Text <Control-i> {
  233.     tkTextInsert %W \t
  234. }
  235. bind Text <Return> {
  236.     tkTextInsert %W \n
  237. }
  238. bind Text <Delete> {
  239.     if {[%W tag nextrange sel 1.0 end] != ""} {
  240.     %W delete sel.first sel.last
  241.     } else {
  242.     %W delete insert
  243.     %W see insert
  244.     }
  245. }
  246. bind Text <BackSpace> {
  247.     if {[%W tag nextrange sel 1.0 end] != ""} {
  248.     %W delete sel.first sel.last
  249.     } elseif [%W compare insert != 1.0] {
  250.     %W delete insert-1c
  251.     %W see insert
  252.     }
  253. }
  254.  
  255. bind Text <Control-space> {
  256.     %W mark set anchor insert
  257. }
  258. bind Text <Select> {
  259.     %W mark set anchor insert
  260. }
  261. bind Text <Control-Shift-space> {
  262.     set tkPriv(selectMode) char
  263.     tkTextKeyExtend %W insert
  264. }
  265. bind Text <Shift-Select> {
  266.     set tkPriv(selectMode) char
  267.     tkTextKeyExtend %W insert
  268. }
  269. bind Text <Control-slash> {
  270.     %W tag add sel 1.0 end
  271. }
  272. bind Text <Control-backslash> {
  273.     %W tag remove sel 1.0 end
  274. }
  275. tkTextClipboardKeysyms F16 F20 F18
  276. bind Text <Insert> {
  277.     catch {tkTextInsert %W [selection get -displayof %W]}
  278. }
  279. bind Text <KeyPress> {
  280.     tkTextInsert %W %A
  281. }
  282.  
  283. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  284. # Otherwise, if a widget binding for one of these is defined, the
  285. # <KeyPress> class binding will also fire and insert the character,
  286. # which is wrong.  Ditto for <Escape>.
  287.  
  288. bind Text <Alt-KeyPress> {# nothing }
  289. bind Text <Meta-KeyPress> {# nothing}
  290. bind Text <Control-KeyPress> {# nothing}
  291. bind Text <Escape> {# nothing}
  292. bind Text <KP_Enter> {# nothing}
  293.  
  294. # Additional emacs-like bindings:
  295.  
  296. if !$tk_strictMotif {
  297.     bind Text <Control-a> {
  298.     tkTextSetCursor %W {insert linestart}
  299.     }
  300.     bind Text <Control-b> {
  301.     tkTextSetCursor %W insert-1c
  302.     }
  303.     bind Text <Control-d> {
  304.     %W delete insert
  305.     }
  306.     bind Text <Control-e> {
  307.     tkTextSetCursor %W {insert lineend}
  308.     }
  309.     bind Text <Control-f> {
  310.     tkTextSetCursor %W insert+1c
  311.     }
  312.     bind Text <Control-k> {
  313.     if [%W compare insert == {insert lineend}] {
  314.         %W delete insert
  315.     } else {
  316.         %W delete insert {insert lineend}
  317.     }
  318.     }
  319.     bind Text <Control-n> {
  320.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  321.     }
  322.     bind Text <Control-o> {
  323.     %W insert insert \n
  324.     %W mark set insert insert-1c
  325.     }
  326.     bind Text <Control-p> {
  327.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  328.     }
  329.     bind Text <Control-t> {
  330.     tkTextTranspose %W
  331.     }
  332.     bind Text <Control-v> {
  333.     tkTextScrollPages %W 1
  334.     }
  335.     bind Text <Meta-b> {
  336.     tkTextSetCursor %W {insert - 1c wordstart}
  337.     }
  338.     bind Text <Meta-d> {
  339.     %W delete insert {insert wordend}
  340.     }
  341.     bind Text <Meta-f> {
  342.     tkTextSetCursor %W {insert wordend}
  343.     }
  344.     bind Text <Meta-less> {
  345.     tkTextSetCursor %W 1.0
  346.     }
  347.     bind Text <Meta-greater> {
  348.     tkTextSetCursor %W end-1c
  349.     }
  350.     bind Text <Meta-BackSpace> {
  351.     %W delete {insert -1c wordstart} insert
  352.     }
  353.     bind Text <Meta-Delete> {
  354.     %W delete {insert -1c wordstart} insert
  355.     }
  356.     tkTextClipboardKeysyms Meta-w Control-w Control-y
  357.  
  358.     # A few additional bindings of my own.
  359.  
  360.     bind Text <Control-h> {
  361.     if [%W compare insert != 1.0] {
  362.         %W delete insert-1c
  363.         %W see insert
  364.     }
  365.     }
  366.     bind Text <2> {
  367.     %W scan mark %x %y
  368.     set tkPriv(x) %x
  369.     set tkPriv(y) %y
  370.     set tkPriv(mouseMoved) 0
  371.     }
  372.     bind Text <B2-Motion> {
  373.     if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {
  374.         set tkPriv(mouseMoved) 1
  375.     }
  376.     if $tkPriv(mouseMoved) {
  377.         %W scan dragto %x %y
  378.     }
  379.     }
  380.     bind Text <ButtonRelease-2> {
  381.     if !$tkPriv(mouseMoved) {
  382.         catch {
  383.         %W insert @%x,%y [selection get -displayof %W]
  384.         }
  385.     }
  386.     }
  387. }
  388. set tkPriv(prevPos) {}
  389.  
  390. # tkTextButton1 --
  391. # This procedure is invoked to handle button-1 presses in text
  392. # widgets.  It moves the insertion cursor, sets the selection anchor,
  393. # and claims the input focus.
  394. #
  395. # Arguments:
  396. # w -        The text window in which the button was pressed.
  397. # x -        The x-coordinate of the button press.
  398. # y -        The x-coordinate of the button press.
  399.  
  400. proc tkTextButton1 {w x y} {
  401.     global tkPriv
  402.  
  403.     set tkPriv(selectMode) char
  404.     set tkPriv(mouseMoved) 0
  405.     set tkPriv(pressX) $x
  406.     $w mark set insert @$x,$y
  407.     $w mark set anchor insert
  408.     if {[$w cget -state] == "normal"} {focus $w}
  409. }
  410.  
  411. # tkTextSelectTo --
  412. # This procedure is invoked to extend the selection, typically when
  413. # dragging it with the mouse.  Depending on the selection mode (character,
  414. # word, line) it selects in different-sized units.  This procedure
  415. # ignores mouse motions initially until the mouse has moved from
  416. # one character to another or until there have been multiple clicks.
  417. #
  418. # Arguments:
  419. # w -        The text window in which the button was pressed.
  420. # x -        Mouse x position.
  421. # y -         Mouse y position.
  422.  
  423. proc tkTextSelectTo {w x y} {
  424.     global tkPriv
  425.  
  426.     set cur [$w index @$x,$y]
  427.     if [catch {$w index anchor}] {
  428.     $w mark set anchor $cur
  429.     }
  430.     set anchor [$w index anchor]
  431.     if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {
  432.     set tkPriv(mouseMoved) 1
  433.     }
  434.     switch $tkPriv(selectMode) {
  435.     char {
  436.         if [$w compare $cur < anchor] {
  437.         set first $cur
  438.         set last anchor
  439.         } else {
  440.         set first anchor
  441.         set last [$w index "$cur + 1c"]
  442.         }
  443.     }
  444.     word {
  445.         if [$w compare $cur < anchor] {
  446.         set first [$w index "$cur wordstart"]
  447.         set last [$w index "anchor - 1c wordend"]
  448.         } else {
  449.         set first [$w index "anchor wordstart"]
  450.         set last [$w index "$cur wordend"]
  451.         }
  452.     }
  453.     line {
  454.         if [$w compare $cur < anchor] {
  455.         set first [$w index "$cur linestart"]
  456.         set last [$w index "anchor - 1c lineend + 1c"]
  457.         } else {
  458.         set first [$w index "anchor linestart"]
  459.         set last [$w index "$cur lineend + 1c"]
  460.         }
  461.     }
  462.     }
  463.     if {$tkPriv(mouseMoved) || ($tkPriv(selectMode) != "char")} {
  464.     $w tag remove sel 0.0 $first
  465.     $w tag add sel $first $last
  466.     $w tag remove sel $last end
  467.     update idletasks
  468.     }
  469. }
  470.  
  471. # tkTextKeyExtend --
  472. # This procedure handles extending the selection from the keyboard,
  473. # where the point to extend to is really the boundary between two
  474. # characters rather than a particular character.
  475. #
  476. # Arguments:
  477. # w -        The text window.
  478. # index -    The point to which the selection is to be extended.
  479.  
  480. proc tkTextKeyExtend {w index} {
  481.     global tkPriv
  482.  
  483.     set cur [$w index $index]
  484.     if [catch {$w index anchor}] {
  485.     $w mark set anchor $cur
  486.     }
  487.     set anchor [$w index anchor]
  488.     if [$w compare $cur < anchor] {
  489.     set first $cur
  490.     set last anchor
  491.     } else {
  492.     set first anchor
  493.     set last $cur
  494.     }
  495.     $w tag remove sel 0.0 $first
  496.     $w tag add sel $first $last
  497.     $w tag remove sel $last end
  498. }
  499.  
  500. # tkTextAutoScan --
  501. # This procedure is invoked when the mouse leaves a text window
  502. # with button 1 down.  It scrolls the window up, down, left, or right,
  503. # depending on where the mouse is (this information was saved in
  504. # tkPriv(x) and tkPriv(y)), and reschedules itself as an "after"
  505. # command so that the window continues to scroll until the mouse
  506. # moves back into the window or the mouse button is released.
  507. #
  508. # Arguments:
  509. # w -        The text window.
  510.  
  511. proc tkTextAutoScan {w} {
  512.     global tkPriv
  513.     if {$tkPriv(y) >= [winfo height $w]} {
  514.     $w yview scroll 2 units
  515.     } elseif {$tkPriv(y) < 0} {
  516.     $w yview scroll -2 units
  517.     } elseif {$tkPriv(x) >= [winfo width $w]} {
  518.     $w xview scroll 2 units
  519.     } elseif {$tkPriv(x) < 0} {
  520.     $w xview scroll -2 units
  521.     } else {
  522.     return
  523.     }
  524.     tkTextSelectTo $w $tkPriv(x) $tkPriv(y)
  525.     set tkPriv(afterId) [after 50 tkTextAutoScan $w]
  526. }
  527.  
  528. # tkTextSetCursor
  529. # Move the insertion cursor to a given position in a text.  Also
  530. # clears the selection, if there is one in the text, and makes sure
  531. # that the insertion cursor is visible.  Also, don't let the insertion
  532. # cursor appear on the dummy last line of the text.
  533. #
  534. # Arguments:
  535. # w -        The text window.
  536. # pos -        The desired new position for the cursor in the window.
  537.  
  538. proc tkTextSetCursor {w pos} {
  539.     global tkPriv
  540.  
  541.     if [$w compare $pos == end] {
  542.     set pos {end - 1 chars}
  543.     }
  544.     $w mark set insert $pos
  545.     $w tag remove sel 1.0 end
  546.     $w see insert
  547. }
  548.  
  549. # tkTextKeySelect
  550. # This procedure is invoked when stroking out selections using the
  551. # keyboard.  It moves the cursor to a new position, then extends
  552. # the selection to that position.
  553. #
  554. # Arguments:
  555. # w -        The text window.
  556. # new -        A new position for the insertion cursor (the cursor hasn't
  557. #        actually been moved to this position yet).
  558.  
  559. proc tkTextKeySelect {w new} {
  560.     global tkPriv
  561.  
  562.     if {[$w tag nextrange sel 1.0 end] == ""} {
  563.     if [$w compare $new < insert] {
  564.         $w tag add sel $new insert
  565.     } else {
  566.         $w tag add sel insert $new
  567.     }
  568.     $w mark set anchor insert
  569.     } else {
  570.     if [$w compare $new < anchor] {
  571.         set first $new
  572.         set last anchor
  573.     } else {
  574.         set first anchor
  575.         set last $new
  576.     }
  577.     $w tag remove sel 1.0 $first
  578.     $w tag add sel $first $last
  579.     $w tag remove sel $last end
  580.     }
  581.     $w mark set insert $new
  582.     $w see insert
  583.     update idletasks
  584. }
  585.  
  586. # tkTextResetAnchor --
  587. # Set the selection anchor to whichever end is farthest from the
  588. # index argument.  One special trick: if the selection has two or
  589. # fewer characters, just leave the anchor where it is.  In this
  590. # case it doesn't matter which point gets chosen for the anchor,
  591. # and for the things like Shift-Left and Shift-Right this produces
  592. # better behavior when the cursor moves back and forth across the
  593. # anchor.
  594. #
  595. # Arguments:
  596. # w -        The text widget.
  597. # index -    Position at which mouse button was pressed, which determines
  598. #        which end of selection should be used as anchor point.
  599.  
  600. proc tkTextResetAnchor {w index} {
  601.     global tkPriv
  602.  
  603.     if {[$w tag ranges sel] == ""} {
  604.     $w mark set anchor $index
  605.     return
  606.     }
  607.     set a [$w index $index]
  608.     set b [$w index sel.first]
  609.     set c [$w index sel.last]
  610.     if [$w compare $a < $b] {
  611.     $w mark set anchor sel.last
  612.     return
  613.     }
  614.     if [$w compare $a > $c] {
  615.     $w mark set anchor sel.first
  616.     return
  617.     }
  618.     scan $a "%d.%d" lineA chA
  619.     scan $b "%d.%d" lineB chB
  620.     scan $c "%d.%d" lineC chC
  621.     if {$lineB < $lineC+2} {
  622.     set total [string length [$w get $b $c]]
  623.     if {$total <= 2} {
  624.         return
  625.     }
  626.     if {[string length [$w get $b $a]] < ($total/2)} {
  627.         $w mark set anchor sel.last
  628.     } else {
  629.         $w mark set anchor sel.first
  630.     }
  631.     return
  632.     }
  633.     if {($lineA-$lineB) < ($lineC-$lineA)} {
  634.     $w mark set anchor sel.last
  635.     } else {
  636.     $w mark set anchor sel.first
  637.     }
  638. }
  639.  
  640. # tkTextInsert --
  641. # Insert a string into a text at the point of the insertion cursor.
  642. # If there is a selection in the text, and it covers the point of the
  643. # insertion cursor, then delete the selection before inserting.
  644. #
  645. # Arguments:
  646. # w -        The text window in which to insert the string
  647. # s -        The string to insert (usually just a single character)
  648.  
  649. proc tkTextInsert {w s} {
  650.     if {($s == "") || ([$w cget -state] == "disabled")} {
  651.     return
  652.     }
  653.     catch {
  654.     if {[$w compare sel.first <= insert]
  655.         && [$w compare sel.last >= insert]} {
  656.         $w delete sel.first sel.last
  657.     }
  658.     }
  659.     $w insert insert $s
  660.     $w see insert
  661. }
  662.  
  663. # tkTextUpDownLine --
  664. # Returns the index of the character one line above or below the
  665. # insertion cursor.  There are two tricky things here.  First,
  666. # we want to maintain the original column across repeated operations,
  667. # even though some lines that will get passed through don't have
  668. # enough characters to cover the original column.  Second, don't
  669. # try to scroll past the beginning or end of the text.
  670. #
  671. # Arguments:
  672. # w -        The text window in which the cursor is to move.
  673. # n -        The number of lines to move: -1 for up one line,
  674. #        +1 for down one line.
  675.  
  676. proc tkTextUpDownLine {w n} {
  677.     global tkPriv
  678.  
  679.     set i [$w index insert]
  680.     scan $i "%d.%d" line char
  681.     if {[string compare $tkPriv(prevPos) $i] != 0} {
  682.     set tkPriv(char) $char
  683.     }
  684.     set new [$w index [expr $line + $n].$tkPriv(char)]
  685.     if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
  686.     set new $i
  687.     }
  688.     set tkPriv(prevPos) $new
  689.     return $new
  690. }
  691.  
  692. # tkTextPrevPara --
  693. # Returns the index of the beginning of the paragraph just before a given
  694. # position in the text (the beginning of a paragraph is the first non-blank
  695. # character after a blank line).
  696. #
  697. # Arguments:
  698. # w -        The text window in which the cursor is to move.
  699. # pos -        Position at which to start search.
  700.  
  701. proc tkTextPrevPara {w pos} {
  702.     set pos [$w index "$pos linestart"]
  703.     while 1 {
  704.     if {(([$w get "$pos - 1 line"] == "\n") && ([$w get $pos] != "\n"))
  705.         || ($pos == "1.0")} {
  706.         if [regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  707.             dummy index] {
  708.         set pos [$w index "$pos + [lindex $index 0] chars"]
  709.         }
  710.         if {[$w compare $pos != insert] || ($pos == "1.0")} {
  711.         return $pos
  712.         }
  713.     }
  714.     set pos [$w index "$pos - 1 line"]
  715.     }
  716. }
  717.  
  718. # tkTextNextPara --
  719. # Returns the index of the beginning of the paragraph just after a given
  720. # position in the text (the beginning of a paragraph is the first non-blank
  721. # character after a blank line).
  722. #
  723. # Arguments:
  724. # w -        The text window in which the cursor is to move.
  725. # start -    Position at which to start search.
  726.  
  727. proc tkTextNextPara {w start} {
  728.     set pos [$w index "$start linestart + 1 line"]
  729.     while {[$w get $pos] != "\n"} {
  730.     if [$w compare $pos == end] {
  731.         return [$w index "end - 1c"]
  732.     }
  733.     set pos [$w index "$pos + 1 line"]
  734.     }
  735.     while {[$w get $pos] == "\n"} {
  736.     set pos [$w index "$pos + 1 line"]
  737.     if [$w compare $pos == end] {
  738.         return [$w index "end - 1c"]
  739.     }
  740.     }
  741.     if [regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  742.         dummy index] {
  743.     return [$w index "$pos + [lindex $index 0] chars"]
  744.     }
  745.     return $pos
  746. }
  747.  
  748. # tkTextScrollPages --
  749. # This is a utility procedure used in bindings for moving up and down
  750. # pages and possibly extending the selection along the way.  It scrolls
  751. # the view in the widget by the number of pages, and it returns the
  752. # index of the character that is at the same position in the new view
  753. # as the insertion cursor used to be in the old view.
  754. #
  755. # Arguments:
  756. # w -        The text window in which the cursor is to move.
  757. # count -    Number of pages forward to scroll;  may be negative
  758. #        to scroll backwards.
  759.  
  760. proc tkTextScrollPages {w count} {
  761.     set bbox [$w bbox insert]
  762.     $w yview scroll $count pages
  763.     if {$bbox == ""} {
  764.     return [$w index @[expr [winfo height $w]/2],0]
  765.     }
  766.     return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
  767. }
  768.  
  769. # tkTextTranspose --
  770. # This procedure implements the "transpose" function for text widgets.
  771. # It tranposes the characters on either side of the insertion cursor,
  772. # unless the cursor is at the end of the line.  In this case it
  773. # transposes the two characters to the left of the cursor.  In either
  774. # case, the cursor ends up to the right of the transposed characters.
  775. #
  776. # Arguments:
  777. # w -        Text window in which to transpose.
  778.  
  779. proc tkTextTranspose w {
  780.     set pos insert
  781.     if [$w compare $pos != "$pos lineend"] {
  782.     set pos [$w index "$pos + 1 char"]
  783.     }
  784.     set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
  785.     if [$w compare "$pos - 1 char" == 1.0] {
  786.     return
  787.     }
  788.     $w delete "$pos - 2 char" $pos
  789.     $w insert insert $new
  790.     $w see insert
  791. }
  792.